

(defun desktop-twiddle ()
  (let* ((*t* (twiddle :in *desktop-container* 
                       :pop-out nil 
                       :draw-color 'black
                       :back-color 'white))  ; :size '(130 40)
         (style (send *desktop-container* :style)))
    (send *t* :frame-location 3000 3000)
    (apply #'send *t* :frame-size (- (send *workmap* :frame-size) '(0 36)))
    (send *t* :pop-open)
    (send *t* :frame-location 0 36)
   ; (setf *b* (workbar :in *desktop-container*))
   ; (send *b* :location 4 24)
   ; (send *b* :size (first (send *workmap* :size)) 30)
   ; (send *b* :always-on-top t)
     (cond
      ((or (= style 1) (= style 3))
       (apply #'send *t* :frame-size (- (send *workmap* :frame-size) '(0 36)))
       (send *t* :pop-open)
       (send *t* :frame-location 0 36))
      (t
       (apply #'send *t* :frame-size (- (send *workmap* :frame-size) '(0 0)))
       (send *t* :pop-open)
       (send *t* :frame-location 0 0))
      )
    (defmeth *t* :do-click (&rest args) (send self :close))
    (defmeth *t* :do-key   (&rest args) (send self :close))
    (defmeth *t* :close () (send self :idle-on nil) (send self :remove))
    *t*))


#|
   
|#

(defun twiddle (&key (in nil) (hide-logo nil) (wire-frame nil) (text nil)
                     (show-time nil used-show-time?) (static nil) (disolve nil) 
                     (delay 0) (pause nil) (speed 1) (speed-multipier 1) 
                     (repeat nil) (full-screen nil set) (x 50) (y 0) (justify "left") 
                     (content-proportion 1) (dynamic-margins t)

                     (location nil) (size '(440 220) size?) (title nil) (show t)
                     (top-most nil) (pop-out t) (margin '(0 0 0 0))
                     (back-color 'black) (draw-color 'yellow)
                     )
  "Args: &KEY (IN NIL) (TEXT NIL) (HIDE-LOGO NIL) (WIRE-FRAME NIL) (STATIC NIL) (SHOW-TIME nil) (DELAY 0) (PAUSE NIL) (SPEED 1) (SPEED-MULTIPLIER 1) (DISOLVE NIL) (REPEAT NIL) (FULL-SCREEN NIL SET) (LOCATION NIL) (SIZE '(440 220) SIZE?)  (TITLE NIL) (SHOW T) (TOP-MOST NIL) (POP-OUT T) (BACK-COLOR 'BLACK) (X 50) (Y 0) (JUSTIFY \"left\") (MARGIN '(0 0 0 0) (CONTENT-PROPORTION 1))

Twiddle shows the animated ViSta logo and, optionally, displays text messages. 
  TEXT specifies one or more messages, and may be 1) a list of strings; 2) a list of lists of strings; or 3) NIL. When TEXT is a list of strings, each string forms one line of one message. When TEXT is a list of lists of strings the elements of a list are displayed as the lines of a message, with the succeeding lists being used to form other messages. The series of messages is presented as a cycle of displays. The timing of the cycle is controlled by SHOW-TIME, which specifies the number of seconds a display is shown, and PAUSE, which specifies the number of seconds between messages. Each defaults to 0, meaning that the next message appears right after the user clicks on the window. 
  The logo is hidden when HIDE-LOGO is T, and is only a wire-frame drawing if WIRE-FRAME is T. When HIDE-LOGO is NIL, the logo appears after DELAY seconds (the text appears immediately). This logo disappears immediately after the last message, unless DISOLVE is T, in which case it disolves slowly. SPEED controls how fast the logo moves. 
  TEXT is horizontally left, center or right justified at X, depending on whether JUSTIFY is LEFT, CENTER or RIGHT. The first line is vertically located at Y. 
  If neither SIZE nor FULL-SCREEN are used, SIZE is set to full screen if the global variable *screen-saver-full-screen* is T, to (440 220) otherwise. If SIZE is used, then the size will equal SIZE unless FULL-SCREEN is T, in which case the size will be full-screen. 
  The twiddle is dynamic unless STATIC is T. CONTENT-PROPORTION specifies the proportion of the distance from the center of the screen to the edge that is used to contain the text and image (when static)."
  
  (when (numberp (first text))
        (let ((text-pointers text))
          (setf text nil)
          (mapcar #'(lambda (pointer)
                      (setf text (append text (list (get-message pointer))))
                      )
                  text-pointers)))
  (when (listp (first text)) (pad-text-lol text))
  (unless (listp (first text)) (setf text (list text)))

  (unless set (setf full-screen 
                    (when (and (boundp '*vista*) *vista*)
                          (send *vista* :screen-saver-full-screen))))

  (let* (;(draw-color 'yellow)
         (object (send logo-proto2 :new 4 
                       :draw-color draw-color :back-color back-color
                       :location location :size size :full-screen full-screen
                       ;dont change values below here
                       :window nil :show nil :go-away nil :glideing nil 
                       :container in :free t :pop-out pop-out :type 0 :about nil 
                       :message-number nil :local-menus t  :copyright-at-top t
                       ))
         (nlns (send object :num-lines))
         (n-msgs (length text))
         (indices (iseq nlns))
         (text-location 'center)
         (show-text t)
         (no-repeat (not repeat))
         (bumpy t)
         (dim 4)
         (speed-factor 1))
    (send object :prepare-logo x y wire-frame hide-logo pause justify used-show-time? show-time n-msgs title top-most no-repeat)
    (defmeth object :do-click (&rest args) 
      (send self :shut-down))
    (defmeth object :do-key (&rest args) (send self :close)) 
    (defmeth object :do-alarm (&rest args) (send self :close))  
    (defmeth object :close () 
      (send self :idle-on nil) 
      (setf *logo* nil)
      (call-next-method)) 
    (setf *logo* object)
    (when (and (not *frames-per-second*) (or (not static) *show-flying-logo*))
	;(one-button-dialog "logoobj3 - calculating frames-per-second")
          (cond
            ((or (not *frames-per-second*)(< *frames-per-second* 1) )
             (setf *frames-per-second* (send object :get-frames-per-second))) 
            ((< 0 *run-number* 5)
             (setf *frames-per-second*
                   (round (/ (+ (* *run-number* *frames-per-second*)
                                (send object :get-frames-per-second)) 
                             (1+ *run-number*))))
             ))
          (send logo-proto :frames-per-second *frames-per-second*))
    (send object :frames-per-second *frames-per-second*)
    (when *verbose* (format t "~%; frames-per-second ~d" *frames-per-second*))
    (send object :speed (* speed (send object :get-frames-per-second)))
    (when *verbose* (format t " speed ~d~%" speed))

    (when pop-out
          (send object :open-window 
                (cond
                  (set *real-screen-size*)
                  (size? size)
                  ((and (boundp '*vista*) *vista*
                        (send *vista* :screen-saver-full-screen)) *real-screen-size*)
                  (t size))))

    (send object :dynamarg-content-proportion content-proportion)
    (send object :dynamarg-speed-factor speed-factor)
    (send object :dynamarg-margin margin)
    (send object :dynamarg-static static)
    (send object :dynamarg-iter 1)
    (cond
      ((not dynamic-margins)
       (send object :dynamarg? t))
      ((not static)
       (send object :dynamarg? t)
       (send object :initialize-dynamarg))
      (t
       (apply #'send object :margin margin)))

    (send object :linestart-coordinate 3 
          (iseq (send object :num-lines))
          (standardize (uniform-rand (send object :num-lines))))
    (send object :std-logo)
    (send object :scale-type 'nil)
    (send object :back-color-default back-color)

#|
 | NEXT STATEMENT CAUSES WINDOW TO APPEAR
 |#

    (cond 
      ((not show) (apply #'send object :location (+ '(100 100) (screen-size))))
      (location (apply #'send object :location location))
      (t (apply #'send object :frame-location
                (if full-screen '(-4 -4) 
                    (floor (* 1/2 (- (screen-size) size)))))))

    (send object :size-loc (combine size location))
    
    (if (= (length text) 0) (setf text (list (list " " " "))))
    (send object :msg-list text)
    (send object :msg-number 0)
    (send object :buffer (select text 0))

    (send object :x-lov 
          (list (send object :linestart-coordinate 0 indices)
                (send object :linestart-coordinate 1 indices)
                (send object :linestart-coordinate 2 indices)
                (send object :linestart-coordinate 3 indices)))

    (send object :speed (* .2 (/ (send object :speed))))
 
    (when (> delay 0)
          (send object :hide-logo t)
          (send object :idle-on nil)
          (send object :redraw)
          (pause (* 60 delay))
          (send object :hide-logo nil))
    
    (send object :timer-on (send object :show-time))
    (when static (send object :idle-on nil)(send object :redraw))
    object))





(defmeth logo-proto2 :prepare-logo (x y wire-frame hide-logo pause justify used-show-time? show-time n-msgs title top-most no-repeat )
    (send self :black-on-white nil)
    (send self :x x)
    (send self :y y)
    (send self :p 0)
    (send self :wire-frame wire-frame)
    (send self :hide-logo hide-logo)
    (send self :pause pause)
    (send self :justify
          (cond
            ((equal justify "left") 0)
            ((equal justify "center") 1)
            ((equal justify "right") 2)))
    (send self :show-time
          (cond 
            (used-show-time? 
             (if (< show-time 0) (error "show-time cannot be negative") show-time))
            ((< n-msgs 2) 3600)
            (t 20)))
    (send self :menu nil)
    (send self :set-show-text t)
    (send self :animate nil)
    (send self :title (if title title " "))
    (send self :top-most top-most)
    (send self :msg-number 0)
    (send self :niter 0)
    (send self :no-repeat no-repeat)
    (send self :set-interrupts t)
  )


(defmeth logo-proto2 :pop-open ()
    ;(let* ((pop-loc (send self :location)))
     ; (send self :location 3000 1)
      (send self :pop-out t)
      (send self :pop-out nil)
     ; (send self :location pop-loc))
    )






#|_______________________________
 |
 | TIMED IDLING 
 |_______________________________
 | 

The :DO-TIMED-IDLE method is substituted for the :do-idle method so that a :DO-TIME method can be used in a way that parallels :do-click and :do-key. :TIMER-ON turns timed idling on or off in a manner like :IDLE-ON. Note that :DO-IDLE works as it always has if the :TIMER-ON method is not used or if it was last used with a value of NIL.
  :DO-TIMED-IDLE is called every cycle through the idle loop with a single argument whose value is NIL if a preset elapsed time has not been exceeded, T if it has been. 
  :DO-TIME is called once, at the time the preset elapsed time is exceeded (when the timer times out). 
  :TIMER-ON turns on timed idling and sets the elapsed time to its argument's value (in seconds). 
Note that :DO-TIMED-IDLE differs form a simple timed loop in a way so that do-click and do-key can interrupt still interrupt the loop. It does this by using the do-idle system.

 |
 |#




(defmeth logo-proto2 :do-time () (send self :do-alarm ()))

(defmeth logo-proto2 :do-alarm ()  )

(defmeth logo-proto2 :timer-on (&optional (time nil used?))
  "Arg: (&optional time)
When not used, reports timer state. When NIL turns timed idling off. When TIME is specified, turns timed idling on and starts timer running for TIME seconds."
  (cond
    (used?
     (send self :idle-start-time nil)
     (cond
       (time 
        (send self :idle-on t)
        (send self :time-limit time)        
      ; (send self :do-timed-idle-loop)
         )
       (t
        (send self :make-interrupt-methods nil)
        (send self :idle-on nil)
        (send self :time-limit nil)))
     time)
    (t (send self :time-limit))))


(defmeth logo-proto2 :idle-timer ()
"arg: none
Timer starts when :IDLE-START-TIME slot is nil, with the current time being put into the slot. Each succeeding call returns nil until elapsed time equals or exceeds the value in the SHOW-TIME slot, when returns t (i.e., indicates whether timer has timed-out). Keeps on running past SHOW-TIME until timer is turned off. SHOW-TIME can be changed while timer is running. Does not change idle state or reset start time slot."
  (let* ((start (send self :idle-start-time))
         (show-time (send self :show-time))
         (now (get-internal-real-time)))
    (unless start 
            (setf start now)
            (send self :idle-start-time start)
            )
   ; (print (list "now" now "start" start "[elapsed" (- now start)
   ;              "] > [max " (* 60 show-time) "]"))
    (> (- now start) (* 60 show-time))))



#|
(defmeth logo-proto2 :margin-zoom ()
  (let* ((size (send self :size))
         (n 100)
         (wid (floor (first size)))
         (hid (floor (second size)))
         (mL (first margin)) 
         (mr (third margin))
         (mT (second margin)) 
         (mB (fourth margin))
         (difL (abs (- (floor (/ wid 2)) mL)))
         (difR (abs (- (floor (/ wid 2)) mR)))
         (difT (abs (- (floor (/ hid 2)) mT)))
         (difB (abs (- (floor (/ hid 2)) mB)))
         (entry-margin (send self :margin))
         )
    (send self :scale-type nil)
    (dotimes (i n)
             (send self :margin 
                   (+ mL (floor (* (/ i n) difL)))
                   (+ mT (floor (* (/ i n) difT)))
                   (+ mR (floor (* (/ i n) difR)))
                   (+ mB (floor (* (/ i n) difB)))
                   ))
    ))
|#

(defmeth logo-proto2 :show-logo ()
  (send self :show-window)
  (send self :pop-out t)
  (send self :front-window)
  (apply #'send self :size (select (send self :size-loc) '(0 1)))
  (apply #'send self :location (select (send self :size-loc) '(2 3)))
  (send self :redraw))
